Cream of the Crop 25/Cream of the Crop 25.iso/os2/srefv12i.zip/counter.rxx

Text File | 1997-04-16 | 17KB | 587 lines

/* This is a server-side-include  "counter display" for SRE-Filter.
  See COUNTER.DOC for details on installation and use.

  Calling syntax:
   1) as a server side include:
         <!-- INTERPRET FILE COUNTER.RXX file=afile opt1=val1 opt2=.. , 0 -->
      where opt1=var1, etc. are additional options
      and where a , 1 signals "read, but do not augment, the counter"

   2) or, from a procedure (such as SENDFILE built in procedure)
       ctval=counter.rxx(optlist,noaugment,usedfile,sel,isent,ilen)

  3) or as an in-line image
       typically as <IMG src="counter.rxx?file=afile&graphic="YES"&optx="xxx"&sel="MYDOC1.HTM">
     The graphic="YES" is required, the SEL="a_selector" is highly recommended.

Note: if a 5th argument is detected, then this is being called as a
      "server side program" (typically, as <Img src="counter.rxx?option_list">

*/

/* ---- BEGIN USER CONFIGURABLE PARAMETERS SECTION ----------  */
/* where to store .cnt files. 0 means "use documents own directory" */
counter_dir=0


/* 1=create a .cnt file if none exists, 0=do not
   if the counter file (passed to counter.rxx) does not exist,
   and create_file=0, counter.rxx will exit without doing anything
*/
create_file=1

/* store info on each request. 0=no, 1=yes */
write_users=1

/* suppress inrementing if request is from a same client with
   suppress_recent minutes. If 0, or if write_users=0, this is ignored */
suppress_recent=0

/* suppress incrementing if request is fron an OWNER */
suppress_owners=1              /*1=yes, 0=no */

/* record using the common-log format  */
common_log_format=1   /* 1=use common log format, 0 = use the save_xxx parameters below */

/* the following are used only if write_users=1 and common_log_format=0 */
save_ipname=1           /* 1=save ip name, 0=do not save ip name     */
save_username=1         /* 1=save username (if avaialble),0=do not   */
save_time=1             /* 1= save time (10:01:33), 0= do not        */
save_date=1             /* 1=Save date (10 Feb 1996), 0=do not       */
save_docname=1          /* 1=save "request selector",0=do not          */
save_referer=1          /* 1=save "referer", 0=do not                */
save_browser=1          /* 1= save the "user-agent", 0=do not         */
save_bytes = 1          /* 1 = save # of bytes sent & file size (or approximations thereof */
/* note that client's IP address, and "julian" time are always saved */

/* END of user-configurable parameters ***********************************/

if counter_dir=' ' then counter_dir=0

sspcall=0

if write_users<>1 then suppress_recent=0
if datatype(suppress_recent)<>'NUM' then suppress_recent=0


parse upper arg optlist , noaugment,usedfile2,docname2,bsent,bsize
theverb=bsent

if upper(theverb)="GET" | upper(theverb)="POST" then do
  sspcall=1
  noaugment=0 ; usedfile2=' '; docname2=' '
  parse arg  ddir, tempfile, reqstrg,optlist,verb ,uri,user, ,
          basedir ,workdir,privset,enmadd,transaction,verbose, ,
         servername,host_nickname,homedir
  docname=uri
  usedfile=translate(ddir,'\','/')
end


optlist=translate(optlist,' ','+&')

if usedfile2<>' ' then usedfile=usedfile2
if docname2<>' ' then docname=docname2

if counter_dir=0 then do
   t1=filespec('d',usedfile)
   t2=filespec('p',usedfile)
   counter_dir=t1||t2
end
counter_dir=strip(counter_dir,'t','\')||'\'

if sspcall=0 then do
  t3=filespec('n',usedfile)
  foo=lastpos('.',t3)
  if foo=0 then
    cfile=t3
  else
    cfile=delstr(t3,foo)
end
else do
  cfile='DEFAULT'
end

cfile=counter_dir||cfile

issilent=0 ; nocommas=0; maxval=21740000 ; ndigits=0 ; minval=0
rollover=0 ; doith=0 ; incit=1 ; dographic=0 ; writesel=' ' ; duration=0
do until optlist=""
  parse var optlist anarg optlist
  parse var anarg avar '=' aval ;
  avar=strip(upper(avar)); aval=strip(strip(aval),,'"')
  select
     when avar="FILE" then do
          foo=lastpos('.',aval) ;
          if foo=0 then
             cfile=counter_dir||aval
          else
             cfile=counter_dir||delstr(aval,foo)
     end
     when avar="SILENT" then issilent=1
     when avar="NOCOMMAS" then nocommas=1
     when avar="MAX" then
        if datatype(aval)='NUM' then maxval=aval
     when avar="WIDTH" then
        if datatype(aval)='NUM' then ndigits=aval
     when avar="MIN" then
        if datatype(aval)='NUM' then minval=aval
     when avar="ROLLOVER" then rollover=1
     when avar="DURATION" then do
        if datatype(aval)='NUM' then duration=aval
     end
     when avar="ITH" then  doith=1
     when avar="SEL" then writesel=strip(aval)
     when abbrev(avar,"GRAPHIC")=1 then do
        select
          when wordpos(upper(aval),'N NO 0')>0 then dographic=0
          when abbrev(upper(aval),'NORMAL')=1 then dographic=1
          when abbrev(upper(aval),'NOTINV')=1 then dographic=1
          otherwise     dographic=2
        end
     end
     when avar="INCREMENT" then do
        if datatype(aval)="NUM" then incit=aval
     end
     otherwise nop
   end
end

if dographic>0 then do
   nocommas=0 ;
   doith=0 ;
end

if  ndigits>0 then nocommas=1

if pos('.',cfile)=0 then cfile=cfile||'.cnt'

/* if create_file=1, then check for existence of cfile, and create
if missing */
if create_file=1 then do
  if stream(cfile,'c','query exists')=' ' then do
     foo=charout(cfile,'0  ',1)
     if foo>0 then do
         if verbose>1 then say " Error creating counter file: " cfile
         return ' '
     end
     foo=stream(cfile,'c','close')
  end
end

/* read it in */
crlf = '0d0a'x
ause=sref_open_read(cfile,30,'BOTH')
if ause<0 then  do                /* couldn't get it */

  if verbose>1 then say " Error opening counter file: " cfile
  return ' '
end

lily=chars(cfile)
ause=strip(charin(cfile,1,lily),'t','1a'x)

/* got a file, let's parse it */
filelins.0=0
iz=0
do until ause=""
      parse  var ause eeo (crlf) ause
     iz=iz+1
     filelins.iz=strip(eeo)
end
if iz=0 then do
   iz=1
   filelins.1=0
end
filelins.0=iz
opstat=iz


/* find count */
ctval=0
do ip=1 to opstat
  aline0=translate(filelins.ip,' ','00090d0a'x)
  select
     when aline0=' ' then iterate
     when  abbrev(aline0,';') then iterate
     when datatype(aline0)='NUM' then do
          ctval0=aline0
          ctval=ctval0+INCIT
          CTVAL=Max(CTVAL,MINVAL) ;
          IF ROLLOVER=1 & CTVAL>MAXVAL THEN CTVAL=MINVAL
          CTVAL=Min(CTVAL,MAXVAL)
   /*       filelins.ip=ctval */
          ct_line=ip
          leave
     end
     otherwise iterate
   end
end
if ctval=0 then do
     ctval=minval+incit
     ctval0=ctval
     itmp=filelins.0+1
/*     filelins.itmp=ctval */
     filelins.0=itmp
     ct_line=itmp
end

numeric digits 12
d1=date('b')
t1=time('m')/(24*60)
nowtime=d1+t1
anaddr=extract('clientaddr')
nowrite=0


/* no augment? */
if noaugment=1 then do
  nowrite=1 ; write_users=0
  ctval=ctval0
end

/* suppress owners? */
if nowrite=0 & suppress_owners=1 then do
   daport=extract('serverport')
   owners=value('SREF_'||daport||'_OWNERS')
   if pos(anaddr,owners)>0 then do
        write_users=0 ; nowrite=1 ;ctval=ctval0 /* no write, don't check */
   end
end

/* if suppress_recent, check before incrementing */
if suppress_recent>0 & write_users=1 then do
  chktime=nowtime-(suppress_recent/(24*60))
  do iy=filelins.0 to ct_line+1 by -1
     aline00=filelins.iy
     if aline00=' ' then iterate
     if abbrev(aline00,';') then iterate
     parse var aline00 anip ',' ajulian ',' .
     ajulian=strip(ajulian)
     if datatype(ajulian)<>"NUM" then iterate
     if ajulian < chktime then leave
     if strip(anip)=anaddr then do
         nowrite=1 ; ctval=ctval0; leave
     end
  end
end

if incit=0 then nowrite=1   /* increment=0 is a "no augment" signal */

filelins.ct_line=ctval          /* record "augmented?" count */

/* if "duration" is <> 0, then check entries (this is used to report
"hits in last week" */

if duration>0  then do
  if write_users<>1 then do
      ctval="000"
   end
   else do
     ctval=1
     chkdate=trunc(1+nowtime-duration)
     do iy=filelins.0 to ct_line+1 by -1
         aline00=filelins.iy
         if aline00=' ' then iterate
         if abbrev(aline00,';') then iterate
         parse var aline00 anip ',' ajulian ',' poop
         ajulian=trunc(strip(ajulian))
         if datatype(ajulian)<>"NUM" then iterate
         if ajulian < chkdate then leave
         ctval=ctval+1
      end
  end   /* write_users */
end  /* duration>0 */

aline=anaddr||', '||nowtime
noss=0

/* write out an entry */
IF nowrite=0 & write_users=1  & common_log_format=1 then do
  itmp=filelins.0+1
  if writesel<> ' ' then
      thereq=writesel
  else
     thereq=docname

/* fake routine starts here --------------------- */
thereq='/'||strip(thereq,'l','/')

mkme=extract('clientmethod')

 d1=space(strip(date('n'))); d1=translate(d1,'/',' ')
 t1=time('n')
 d1t1=d1||':'||t1

 agmt=gmtoffset()
 if datatype(agmt)='NUM' then do
         agmt=agmt/36
         if abs(agmt)<1000 then do
             if agmt>0 then
                 agmt='0'||agmt
             else
                 agmt='-0'||abs(agmt)
         end
 end
 d1t1=d1t1||' '||agmt

  mkme=mkme||' '||thereq
  mkme=mkme||' '||extract('clientprotocol')
  d1t1='['||d1t1||']'
  clientname0=clientname()
  record2='- '||extract('bytessent')

  username='-'
  goo=reqfield('AUTHORIZATION:')
  if goo<>' ' then do
          parse var goo . m64 .              /* get the encoded cookie */
          dec=pack64(m64)                       /* and decode it */
          parse upper var dec username ':' pwd      /* split to userid and pwd*/
  end

  aline2=clientname0||' - '||username||' '||d1t1||' "'||mkme||'" '||record2
  noss=1
/* fake routine ends here --------------- */



  filelins.itmp=aline||', '||aline2
  filelins.0=itmp
end

 itmp=filelins.0+1

/* check various conditions: username ipname time date docname referer
*/
if noss=0 then do
  if save_username=1 then do
      goo=reqfield('AUTHORIZATION:')
      if goo=' ' then do
          username=' '
      end
      else do
          parse var goo . m64 .              /* get the encoded cookie */
          dec=pack64(m64)                       /* and decode it */
          parse upper var dec username ':' pwd      /* split to userid and pwd*/
      end
      aline=aline||', '||strip(username)
  end

  if save_ipname=1 then do
        aline=aline||', '||clientname()
  end
  if save_time=1 then do
         aline=aline||', '||time('n')
  end
  if save_date=1 then do
        aline=aline||', '||date('n')
  end
  if save_docname=1 then do
     if writesel<>' ' then
        aline=aline||', '||writesel
     else
        aline=aline||', '||docname
  end

  if save_bytes=1 then do
      if bsent="" then bsent=extract('bytessent')
      if bsize="" then do
         bsize=0
         if  usedfile2 <>  " " then
              bsize=dosdir(usedfile2,'S')
      end
      aline=aline||', '||bsent' 'bsize
  end

  if save_referer=1 then do
        aline=aline||', '||reqfield('referer')
  end
  if save_browser=1 then do
        aline=aline||', '||reqfield('user-agent')
  end
  filelins.itmp=aline
  filelins.0=itmp
end

/* write out stuff */
if nowrite=0 then do
  stuff=filelins.1
  do mm=2 to filelins.0
     stuff=stuff||crlf||filelins.mm
  end
  stuff=stuff||'             '
  wow=charout(cfile,stuff,1)
  if wow>0 & verbose>0 then say " Warning: problem writing .CNT file: " wow
end
foo=stream(cfile,'c','close')

if issilent=1 then return ' '   /* just record, do not display */


/* format ctval */
ctval=strip(ctval)
ctlen=length(ctval)


if ndigits>0 then do
    if ctlen<ndigits then do
        ctval=copies('0',ndigits-ctlen)||ctval
    end
end


if nocommas=0 then do
  il=length(ctval)
  if il>3 then do
      oop=""
      do mm=il to 3 by -3
         tt=substr(ctval,mm-2,3)
         if mm=il then
            oop=tt
         else
            oop=tt||','||oop
      end /* do */
      if mm<>0 then oop=substr(ctval,1,mm)||','||oop
      ctval=oop
  end
end


if doith=1 then do
  lval2=right(strip(ctval),2)
  if lval2>10 & lval2<20 then
        ctval=ctval||'th'
  else do
     lval=right(strip(ctval),1)
     select
       when lval=0 then  ctval=ctval||'th'
       when lval=1 then ctval=ctval||'st'
       when lval=2 then ctval=ctval||'nd'
       when lval=3 then ctval=ctval||'rd'
       otherwise ctval=ctval||'th'
     end
  end
end


if dographic=0 then return ctval

/**********************************************************/
/* else, return as an xbm file (using d meyer's xcount code) */

bytes = '';
bytecount = 0;

env = "OS2ENVIRONMENT"
minLen = 7;           /* minimum number of digits in bitmap */
if ndigits>0 then minlen=ndigits
isHigh = 1;           /* if 1, digits are 16 pixels high, to allow room for border */
isInverse = 1;        /* if 1, digits are white on black */
if dographic=1 then isinverse=0

   /* bitmap for each digit
      Each digit is 8 pixels wide, 10 high
      invdigits.x are white on black, digits.x black on white */
   invdigits.0 = "c3 99 99 99 99 99 99 99 99 c3";   /* 0 */
   invdigits.1 = "cf c7 cf cf cf cf cf cf cf c7";   /* 1 */
   invdigits.2 = "c3 99 9f 9f cf e7 f3 f9 f9 81";   /* 2 */
   invdigits.3 = "c3 99 9f 9f c7 9f 9f 9f 99 c3";   /* 3 */
   invdigits.4 = "cf cf c7 c7 cb cb cd 81 cf 87";   /* 4 */
   invdigits.5 = "81 f9 f9 f9 c1 9f 9f 9f 99 c3";   /* 5 */
   invdigits.6 = "c7 f3 f9 f9 c1 99 99 99 99 c3";   /* 6 */
   invdigits.7 = "81 99 9f 9f cf cf e7 e7 f3 f3";   /* 7 */
   invdigits.8 = "c3 99 99 99 c3 99 99 99 99 c3";   /* 8 */
   invdigits.9 = "c3 99 99 99 99 83 9f 9f cf e3";   /* 9 */


      digits.0 = "3c 66 66 66 66 66 66 66 66 3c";   /* 0 */
      digits.1 = "30 38 30 30 30 30 30 30 30 30";   /* 1 */
      digits.2 = "3c 66 60 60 30 18 0c 06 06 7e";   /* 2 */
      digits.3 = "3c 66 60 60 38 60 60 60 66 3c";   /* 3 */
      digits.4 = "30 30 38 38 34 34 32 7e 30 78";   /* 4 */
      digits.5 = "7e 06 06 06 3e 60 60 60 66 3c";   /* 5 */
      digits.6 = "38 0c 06 06 3e 66 66 66 66 3c";   /* 6 */
      digits.7 = "7e 66 60 60 30 30 18 18 0c 0c";   /* 7 */
      digits.8 = "3c 66 66 66 3c 66 66 66 66 3c";   /* 8 */
      digits.9 = "3c 66 66 66 66 7c 60 60 30 1c";   /* 9 */

totalreads = ctval
bytecount=0
/* now generate the Bitmap
                    minLen contains minimum number of digits to display
                    isHigh is one for 16 bit high numbers (else 10)
                    isInverse is one for reverse video (white on black) */
/* Stuff 0 to length of counter */
len = Length(totalreads);
crlf = '0a'x        /* image/x-xbitmap format depends on only having a LF char... */
if len < minLen Then len = minlen;
  formattedcount = right(totalreads, len, '0');

if isHigh then do
   do i = 0 to len * 3 - 1
      if isInverse then
         bytes = bytes"0xff";       /* add three blank rows to each digit */
      else
         bytes = bytes"0x00";
      bytecount = bytecount + 1;
      if bytecount//len <> 0
      then bytes=bytes','
      else bytes=bytes',' || crlf
   end
end

/* make the digits */
do y = 0 to 9
   do x = 1 to len
      digit = substr(formattedCount,x,1);
      if isInverse then               /* $inv = 1 for inverted text */
         byte = substr(invdigits.digit, y*3+1,2);
       else
         byte = substr(digits.digit,y*3+1,2);
         bytes = bytes'0x'byte;
      bytecount = bytecount + 1;
      if bytecount//len <> 0
      then bytes=bytes','
      else bytes=bytes',' || crlf
   end
end
if isHigh then do
   do i = 0 to len*3 - 1
      if isInverse then
         bytes = bytes"0xff";       /* add three blank rows to each digit */
      else
         bytes = bytes"0x00";
      bytecount = bytecount + 1;
      if bytecount//len <> 0
      then bytes=bytes','
      else bytes=bytes',' || crlf
   end
end
out_text = "#define count_width "len*8 || crlf
if isHigh then
   out_text = out_text || "#define count_height 16" || crlf
else
   out_text = out_text || "#define count_height 10" || crlf
out_text = out_text || "static char count_bits[] = {" || crlf
out_text = out_text || reverse(substr(reverse(bytes), (2 + length(crlf))))'};' || crlf
'HEADER NOAUTO'
'RESPONSE HTTP/1.0 200 OK '     /* Set HTTP response line */
aserv=server()
'header add Server: ' ||aserv
adate=sref_new_gmt()||'|| GMT '
'header add Date: '|| adate
'header add Content-Type: image/x-xbitmap '
llen = Chars(tempfile)
'header add Content-Length: '||llen
'header add Content-Transfer-Encoding: binary '
'header add Expires: ' ||adate

/*wow=dosrename(tempfile,'g:\goserv\temp\me.xbm')*/
'VAR TYPE image/x-xbitmap name out_text '

return 'COUNTER: X-BITMAP sent ' length(out_Text)